home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Module source / zFEmod.txt < prev    next >
Text File  |  1998-01-29  |  6KB  |  251 lines
  1. \ Handles Mops user interface.
  2.  
  3. syscall OpenRF
  4. syscall FSClose
  5. syscall HCreateResFile
  6. syscall CloseResFile
  7. syscall CurResFile
  8. syscall HOpenResFile
  9.  
  10.  
  11. // alert
  12.  
  13.     string    IMAGENAME            \ Current Mops dictionary image name
  14.     string    APPL_NAME            \ Default appl name for Install
  15.     string    APPL_VERS            \ Ditto version string
  16. 0    value    APPL_SIG            \ Ditto signature
  17.  
  18.  
  19. \ MOPS_OBJECTS sets up system objects for the Mops development environment.
  20. \ We put it first so that we can tick the exported versions of some words,
  21. \ which have to be referred to by vectors or x-arrays (since a module can
  22. \ only be invoked through an exported word).
  23.  
  24. \ Note: the various things we do below in setting up fWind can't be done
  25. \ by SysInit, since under System 7 fWind doesn't exist until a dictionary
  26. \ is read in, which is later than SysInit time.  But for an installed
  27. \ application which uses fWind, this module won't exist, so we have a
  28. \ separate initialization word AppInit (in file ObjInit) which is called
  29. \ by ObjInit for an installed application.  fWind will then be available
  30. \ from the start, so AppInit does the setting up.
  31.  
  32.  
  33. : MOPS_OBJECTS  { \ left top right bottom -- }
  34.     ['] (about)  -> aboutVec
  35.     fWind?
  36.     IF    classinit: fWind   markalive: fWind
  37.         ['] enFW  ['] disFW        setAct: fWind
  38.         myDoc 2dup  title: fWind  put: imageName
  39.         ScreenBits  -> bottom  -> right  -> top  -> left
  40.         70 70 right bottom  true  setGrow: fWind
  41.         setContRect: fWind
  42.     THEN  ;
  43.  
  44.  
  45. \        =========== Menu handlers ===========
  46.  
  47.  
  48. 1 alert    ABTALRT        ' null 1  put: abtAlrt
  49. 1 alert    nimplAlrt    ' null 1  put: nimplAlrt
  50.  
  51.  
  52. variable    VERSION        40 allot
  53.  
  54. : (ABOUT)
  55.     50 getString  version  place
  56.     0 0  version count  0 0  0 0  paramText
  57.     128 16  disp: abtAlrt  ;
  58.  
  59. : xNIMPL
  60.     129 cautionAlert  disp: NimplAlrt  ;
  61.  
  62.  
  63. \        =============== File Menu ===============
  64.  
  65.     0    value    CURRVREF
  66. false    value    SAVED?        \ True if dic image saved at least once
  67.     0    value    SAVE_RC        \ I/O return code from dic save
  68.     variable    fRefNum
  69.  
  70.  
  71. : .SAVED
  72.     type# 101 ( Saved: )  getname: ffcb  type  cr  ;
  73.  
  74.  
  75. : SAVEDIC  { \ fRefNum -- }
  76.     get: imageName  name: fFcb  currVref  setVref: fFcb
  77.     
  78. \ now we can't just use  create: ffcb, since that method just opens the
  79. \  file if it already exists, and when we try to write the resources we'll
  80. \  get an error since they're there already.  We have to actually delete
  81. \  the file in this situation.
  82.  
  83.     open: ffcb
  84.     NIF            \ no error - i.e. it exists
  85.         close: ffcb drop
  86.         delete: ffcb  OK?
  87.     THEN
  88.     create: ffcb  OK?
  89.     'type APPL  'type MOPP  set: ffcb
  90.     currVRef  0  get: imageName str255  HCreateResFile  drop resChk
  91.     currVref  0  buf255  0  HOpenResFile  -> fRefNum  resChk
  92.     get: imageName  32 min  myDocName place
  93.     true  false  (wp)        \ true = res fork open, false = not installing
  94.     fRefNum  CloseResFile  resChk
  95.     close: ffcb  drop
  96.     true -> saved?  .saved
  97. ;
  98.     
  99.  
  100. : STDSAVE        \ save via stdFile
  101.     " Save Mops image as:"  saved? IF  get: imagename  ELSE  myDoc  THEN
  102.     stdPut: fFcb
  103.     IF
  104.         getVref: fFcb  -> currVref
  105.         getName: fFcb  put: imageName
  106.         saveDic
  107.     THEN  ;
  108.  
  109. : DOSAVE        \ Resave current dictionary.
  110.     saved?
  111.     IF        saveDic
  112.     ELSE    stdSave
  113.     THEN  ;
  114.  
  115.  
  116. : PSETUP        \ page setup
  117.     nimpl  ;
  118.  
  119.  
  120. \        ============= List Menu ===============
  121.  
  122. : doOlist    nimpl  ;
  123. : doClist    nimpl  ;
  124.  
  125.  
  126. \        ============= Show Menu ===============
  127.  
  128. : x.ROOM
  129.     cr
  130.     ." Room in data area of dictionary:               "  room2        7 .r cr
  131.     ." Room in code area of dictionary:               "             7 .r cr
  132.     ." Distance to top of mainData range (neg is OK): "
  133.                             mainData half_displ_range +  DP -        7 .r cr
  134.     ." Distance to top of mainCode range:             "  headroom    7 .r cr
  135.     ." Total heap (no purge):                         "  free        7 .r  cr
  136.     ." Largest block (purge):                         "  freeblk    7 .r  cr
  137. ;
  138.  
  139. \        ============= Utilities Menu ===============
  140.  
  141.  
  142. : CHKUTIL    \ ( item# b -- ) check item if boolean is true
  143.     IF        check: utilMen
  144.     ELSE    unCheck: utilMen
  145.     THEN  ;
  146.  
  147. \ false    value    PRECHO?  \ 31Jan94 DBH
  148.  
  149. \ : ?UTILFLGS    1 echo? chkUtil  0 prEcho? chkUtil  ;
  150. : ?UTILFLGS        0 echo? chkUtil ;  \ 31Jan94 DBH
  151.  
  152.  
  153. : LECHO        \ Toggles echo during loads
  154.     echo? not -> echo?  ?utilFlgs  ;
  155.  
  156.  
  157. : DOPURGE  ;
  158.  
  159.  
  160.  
  161. : DISFW
  162.     false -> fWindActive?  ;
  163.  
  164. : ENFW
  165.     true -> fWindActive?  ;
  166.  
  167. : NMENU
  168.     xts{  null null null null null null null null null  }
  169.                                                         3  init: EditMen
  170.             \ this gets properly initialized in TEFwindMod
  171.  
  172.     getnew: AppleMen  getnew: FileMen  getnew: EditMen
  173.     getnew: ListMen  getnew: ShowMen  getnew: UtilMen
  174.     AppleMen FileMen EditMen ListMen ShowMen UtilMen    6  init: MenuBar
  175.     ?utilFlgs
  176. ;
  177.  
  178. (* *****
  179. \                ============= Edit Menu ===============
  180.  
  181. \ Note: the Edit Menu stuff MUST COME AFTER the definition of Nmenu.  This
  182. \ is because we must set up the menu with the EXPORTED versions of the
  183. \ words doUndo etc.  Because we haven't defined these words here in the module
  184. \ yet, only the exported versions are visible from Nmenu, which is what we
  185. \ want.
  186.  
  187.  
  188. \ Scrap support
  189.  
  190.     string    PARMSTR
  191.     var        THEOFFSET
  192.     handle    SCRAPHDL
  193.  
  194. : DoUndo    nimpl  ;
  195. : doCut        nimpl  ;
  196. : doCopy    nimpl  ;
  197. : doClear    nimpl  ;
  198. : doSelAll    nimpl  ;
  199.  
  200.  
  201. : get_scrap        \ ( -- len )
  202.     0 0 put: parmStr  handle: parmStr  put: scrapHdl
  203.     get: scrapHdl  'type TEXT  addr: theOffset
  204.     GetScrap
  205.     setSize: parmStr  lock: parmStr  len: parmStr  ;
  206.  
  207. : SCRAPKEY    \ Gets next char from the scrap
  208.  
  209.     len: parmStr
  210.     NIF  key!  13  EXIT  THEN        \ Simulate a terminal CR
  211.     1st: parmStr  1 skip: parmStr  ;
  212.  
  213.  
  214. : DOPASTE        \ Interprets from the scrap
  215.     get_scrap 0<=  ?EXIT
  216.     false -> relocChk?  ['] scrapKey -> key  true -> relocChk?
  217.     sp0 sp!  quit  ;
  218.  
  219. **** *)
  220.  
  221. : xPref        nimpl  ;
  222.  
  223.  
  224. \ The following words are called by Install to get and set the default name, version and signature for the current application.  They are initialized to the Mops values, but may be changed at any time.  Note that the first two of these words return a string object, rather than an addr and a length.  This was simpler for Install, and they shouldn't be getting called from anywhere else.
  225.  
  226. : GET_APPL_NAME        appl_name  ;
  227. : GET_APPL_VERS        appl_vers  ;
  228. : GET_APPL_SIG        appl_sig  ;
  229.  
  230. : SET_APPL_NAME        put: appl_name  ;
  231. : SET_APPL_VERS        put: appl_vers  ;
  232. : SET_APPL_SIG        -> appl_sig  ;
  233.  
  234. \ system startup word:
  235.  
  236. : RUN_FE
  237.     mops_objects  openMR  nMenu
  238.     " mops.paths"    getPaths
  239.     " Mops"            put: appl_name
  240.     50 getString    put: appl_vers
  241.     'type MOPS    -> appl_sig
  242.     20 -> sleepticks
  243.     run_TE
  244. ;
  245.  
  246.  
  247. : (REL)
  248.     release: imageName  ;
  249.  
  250. ' (rel)  setrelease
  251.